perm filename SYMFUN.RLS[206,JMC] blob sn#005326 filedate 1971-01-15 generic text, type T, neo UTF8
00100	OFF ECHO;
00200	
00300	COMMENT MUL(U,V) GIVES THE PRODUCT OF THE SYMMETRIC MONOMIALS  U
00400	AND  V.  U  AND  V  ARE REPRESENTED AS DESCENDING LISTS OF EXPONENTS.
00500	THUS, (3 2 1) REPRESENTS  SIGMA(X1↑3*X2↑2*X3).  THE RESULT IS
00600	GIVEN AS A LIST OF TERMS EACH OF WHICH IS A LIST CONSISTING
00700	OF A COEFFICIENT AND SYMMETRIC MONOMIAL IN THE ABOVE NOTATION.  THUS
00800	MUL('(1),'(1)) = ((1 (2)) (2 (1 1))) WHICH REPRESENTS THE FACT THAT
00900	(X+Y+Z)*(X+Y+Z) = (X↑2+Y↑2+Z↑2) + 2*(XY+YZ+ZX).  ALL THE FUNCTIONS UP
01000	TO  MUL  ARE ITS SATELLITES.;
01100	
01200	FOO(U,V,P,L) ← IF NULL V THEN APPEND(P,U) . L
01300		ELSE FOO(U,CDR V,CAR V.P,FOO1(U,U,CAR V,
01400			CDR V,P,L));
01500	
01600	FOO1(U,U1,X,V,P,L) ← IF NULL U1 THEN L ELSE
01700		FOO(DEL(U1,U),V,(CAR U1 + X).P,
01800			FOO1(U,CDR U1,X,V,P,L));
01900	
02000	DEL(U1,U) ← IF U1 EQ U THEN CDR U ELSE
02100		CAR U . DEL(U1,CDR U);
02200	
02300	ORDERB U ← IF NULL U THEN NIL ELSE MERGE(CAR U,ORDERB CDR U);
02400	
02500	MERGE(X,U) ← IF NULL U THEN LIST X ELSE IF X > CAR U THEN
02600		X.U ELSE CAR U . MERGE(X,CDR U);
02700	
02800	COEFFA U ← IF NULL U THEN 1 ELSE COEFFB(1,CAR U,CDR U);
02900	
03000	COEFFB(N,X,U) ← IF NULL U THEN 1 
03100		ELSE IF X = CAR U THEN (N+1)*COEFFB(N+1,X,CDR U)
03200		ELSE COEFFB(1,CAR U,CDR U);
03300	
03400	ORDERA U ← IF NULL U THEN NIL ELSE MERGEA(CADAR U,
03500		ORDERA CDR U);
03600	
03700	MERGEA(X,U) ← IF NULL U THEN LIST(LIST(1,X))
03800		ELSE IF GRR(X,CADAR U) THEN LIST(1,X).U
03900		ELSE IF X=CADAR U THEN LIST(CAAR U + 1,X) . CDR U
04000		ELSE CAR U . MERGEA(X,CDR U);
04100	
04200	GRR(U,V) ← NOT NULL U AND ((CAR U > CAR V) 
04300		OR (CAR U = CAR V AND GRR
04400						(CDR U,CDR V)));
04500	
04600	MUL(U,V)← (LAMBDA(M); MAPCAR(ORDERA(MAPCAR(
04700	FOO(U,V,NIL,NIL),FUNCTION(LAMBDA(W);
04800	LIST(1,ORDERB W)))),FUNCTION(LAMBDA(Z);
04900	LIST(QUOTIENT(CAR Z * COEFFA CADR Z,M),CADR Z))))
05000	(COEFFA U * COEFFA V);
05100	
05200	ZAPB(W,M) ← IF CAR W = M THEN NIL ELSE 
05300			(CAR W - M) . ZAPB(CDR W,M);
05400	
05500	ZAPA(W) ← (LAMBDA (L,M); IF L=0 THEN NIL
05600		ELSE LIST(M,SIG(L)) . ZAPA(ZAPB(W,M)))
05700			(LENGTH W,CAR LAST W);
05800	
05900	SIG(N) ← LIST('SIGMA,N);
06000	
06100	ZAP V ← LIST(CAR V,ZAPA CADR V);
06200